home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
netmail
/
rnr214.zip
/
RNRSELB.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-03-04
|
82KB
|
3,423 lines
unit rnrselb;
{
rnrselb.pas - rnr selectandbrowse, viewarts, browseart and friends
}
{$I rnr-def.pas}
interface
uses rnrglob,rnrconf,genericf,rnrfunc,rnrio,rnrproc,rnrkill,
rnrmous,rnrfile,rnrinit,rnrart,rnrcrea
{$ifdef charset}
,rnrchar
{$endif}
;
const
yesfirstantikill=true;
nofirstantikill=false;
procedure selectandbrowse;
implementation
var
moreselecting: boolean;
skipsection: boolean;
starbeside: integer;
selected: array[1..maxarts] of boolean;
numselected: integer;
topline,botline: integer;
selsearchstring: string;
procedure setselected(artnum: integer; b: boolean);
begin
if selected[artnum]<>b then
begin
if b then
inc(numselected)
else
dec(numselected);
selected[artnum] := b;
end;
end;
procedure selrefreshbotline;
var
perthroughgroup: integer;
begin
{handle short-integer math}
if numarts>600 then
perthroughgroup := (10*botline) div (numarts div 10)
else if numarts>300 then
perthroughgroup := (20*botline) div (numarts div 5)
else
perthroughgroup := (100*botline) div numarts;
if perthroughgroup>100 then
perthroughgroup := 100; {handle roundoffs more gracefully!}
xclreolxy(1,sellpp+selheaderlines+3);
xwritesss('?=help ',currenttimestring,' ');
xwritei(perthroughgroup);
xwrites('% through this group ');
xwritei(numarts-botline);
xwrites(' more ');
if not quiet then
begin
xwritei(numselected);
xwrites(' selected ');
end;
xwriteln;
{
xwritelnsssisis('?=help ',currenttimestring,' ',throughgroup,
'% through this group ',numarts-botline,' more on later screen(s)');
}
xclreol;
xgotoxy(1,sellpp+selheaderlines+4);
end;
procedure browseart(artnum: integer; numleft: integer;
var willupdatej: boolean);
var
quitatarteof: boolean;
lastlineshown: integer;
artfrom: string;
artsubject: string;
artmessageid: string;
artnewsgroups: string;
numlefts: string[30];
totlines: integer;
sawendofarticle: boolean;
procedure newbrowsescreen;
begin
xclrscr;
end;
procedure morelines(linestoshow: integer);
var
s: string;
ff: boolean;
wastec: char;
brandnewlinesshown: integer;
begin
if arteof then
begin
if sawendofarticle or not confirmnextarticle then
donebrowse := true
else
begin
{ can't use warn here -- the last line might be in the middle of the screen }
{warn('end of article');}
xwrites('end of article -- press any key ');
wastec := xreadkey;
xwrites(cr);
xclreol;
sawendofarticle := true;
quitatarteof := false;
end
end
else
begin
sawendofarticle := false; {just in case they rewound}
quitatarteof := false;
ff := false;
brandnewlinesshown := 0;
while not arteof and (brandnewlinesshown<linestoshow) and not ff do
begin
getartl(s,cols-1,yestoscreen);
ff := (pos(^L,s)<>0);
showartl(s);
if pos('@',s)<>0 then
bodyaddress := getaddressfromline(s);
inc(brandnewlinesshown);
inc(lastlineshown);
end;
end;
end;
procedure rewindtopline(newtopline: integer);
const
twirl='/-\|';
var
s: string;
skippedlines: integer;
toggle: integer;
begin
toggle := 1;
newbrowsescreen;
quitatarteof := false;
artreset;
lastlineshown := 0;
skippedlines := min(0,newtopline);
while skippedlines<newtopline do
begin
getartl(s,cols-1,yestoscreen);
inc(skippedlines);
inc(lastlineshown);
if (skippedlines and 31)=0 then
begin
xwritess(copy(twirl,toggle,1),#8);
toggle := 1+(toggle mod 4);
end;
end;
xwritess(' ',#8); {erase the rotating char}
morelines(lpp-1);
end;
procedure browserefresh;
begin
rewindtopline(lastlineshown-lpp+1);
end;
procedure showlastline;
var
wastes: string;
begin
if totlines<0 then
begin
xwrites('Searching for bottom line...');
totlines := 0;
artreset;
while not arteof do
begin
inc(totlines);
getartl(wastes,cols-1,yestoscreen);
end;
end;
rewindtopline(totlines-lpp+1);
end;
procedure browsehelppage;
var
wastec: char;
begin
xclrscr;
hwritexy(1,1,
newsreadername+' '+newsreaderversion+' - newsreader-under-development');
hwritexy(1,2,
'Russell_Schulz@locutus.ofB.ORG ('+releasedate+')');
hwritexy(1,4,
'{space},{d},{CR} - forward 1 page, 1/2 page, 1 line');
hwritexy(1,5,
'{u} - back 1 page {=} back to selection screen');
hwritexy(1,6,
'{^},{$} - top, bottom line {TAB} skip this Subject: group');
hwritexy(1,7,
'{n},{p} - next,previous selected article (or next group if at end)');
hwritexy(1,8,
'{b},{a} - back,ahead through all articles (selected or unselected)');
hwritexy(1,9,
'{r} - reply to author (in mail) {/} search {.} search again');
if maypost then
hwritexy(1,10,
'{m} - remail this message {f} - followup (public, in netnews)')
else
hwritexy(1,10,
'{m} - remail this message');
hwritexy(1,11,
'{k} - kill by subject or author (to not display again)');
hwritexy(1,12,
'{K} - antikill by subject or author (for auto-selection)');
hwritexy(1,13,
'{^R} - reread kill and antikill files from disk');
if trusted then
hwritexy(1,14,
'{e} - edit actual article {A} - add alias {D} - rot13 decode')
else
hwritexy(1,14,
' {A} - add alias {D} - rot13 decode');
hwritexy(1,15,
'{x} - extract embedded file {s},{w} - save/write article to disk');
hwritexy(1,16,
'{h} - toggle full header display {^L} - refresh screen');
hwritexy(1,17,
'{!} - shell escape {^D} - delete {N} - next group (no update)');
hwritexy(1,19,
'{?} - help {:} command mode {Q} - quit (no update)');
hwritexy(1,21,'file:');
hwritexy(7,21,artfn);
hwritexy(1,23,
'see rnr.doc for more information. press any key to return ');
wastec := xreadkey;
browserefresh;
end;
procedure browseback;
begin
donebrowse := true;
browsedir := -1;
browseonlysel := false;
end;
procedure browseahead;
begin
donebrowse := true;
browseonlysel := false;
end;
procedure editart;
begin
if trusted then
begin
artclose;
mouseshutdown;
execp(editor,editoroptions+' '+artfn);
mouseinit;
if execresult<>0 then
warnerr(editor,execresult);
artreset;
browserefresh;
headerinmem := ''; {in case user edited headers}
end;
end;
procedure actuallyreplytoart;
var
subject: string;
inreplyto: string;
replyaddr: string;
artreplyto: string;
toaddr: string;
newreplyaddr: string;
replyname: string;
defaultreply: boolean;
author: string;
originalfrom: string;
ccaddr: string;
afullname: string;
begin
artclose;
subject := artsubject;
subject := 'Re: '+nore(subject);
inreplyto := artmessageid;
replyaddr := '';
artreplyto := getheaderline(artfn,'reply-to:');
if isreasonableaddress(artreplyto) then
replyaddr := artreplyto;
if replyaddr='' then
replyaddr := artfrom;
if replyaddr='' then
replyaddr := mailfrom;
author := getfromaddr(replyaddr);
if (author=getfromaddr(mailfrom)) or (author=getfromaddr(newsfrom)) then
begin
toaddr := getheaderline(artfn,'to:');
if toaddr<>'' then
begin
if isreasonableaddress(toaddr) then
replyaddr := toaddr;
end;
end;
if not isreasonableaddress(author) then
if pos('@',replyaddr)<>0 then
begin
warn2('it looks like there are problems with the headers',
'for this message -- trying to compensate with other headers');
replyaddr := getaddressfromline(replyaddr);
author := replyaddr;
end;
if not isreasonableaddress(author) then
if isreasonableaddress(bodyaddress) then
begin
warn2('it looks like there are problems with the headers',
'for this message -- trying to compensate with body text');
replyaddr := bodyaddress;
author := replyaddr;
end;
{handle case where Reply-To: is same as From:, but without name - keep it}
if getfromname(replyaddr)='' then
if upper(getfromaddr(replyaddr))=upper(getfromaddr(artfrom)) then
replyaddr := artfrom;
{`sender' isn't legal, but I've seen it}
if (replyaddr='poster') or (replyaddr='sender') then
replyaddr := artfrom;
if not isreasonableaddress(replyaddr) then
begin
warn('invalid address -- trying From: header');
replyaddr := artfrom;
end;
replyname := getfromname(replyaddr);
replyaddr := getfromaddr(replyaddr);
{use `warn2' to avoid overwriting an address in the sig, say}
if upper(replyaddr)<>upper(getfromaddr(artfrom)) then
warn2(
'just for your info: From: header not used -- either Reply-To: or To: or',
'body text was used, in order to get the most useful address');
xclreolxy(1,lpp);
xwrites('Reply To: ');
newreplyaddr := replyaddr;
xreadlnse(newreplyaddr,cols-15,yespreserve,endkeyswithspace);
if newreplyaddr='' then
newreplyaddr := replyaddr;
defaultreply := (newreplyaddr=replyaddr);
if not defaultreply then
begin
replyaddr := newreplyaddr;
replyname := '';
end;
{get the address (if possible) from aliases and user/*/forward files}
replyaddr := expandmail(replyaddr);
if not quiet then
begin
xclreolxy(1,lpp-1);
xclreolxy(1,lpp-2);
if (pos('!',replyaddr)=0) and
(pos('@',replyaddr)=0) and
(pos(',',replyaddr)=0) then
begin
afullname := getfullnameforuser(lower(replyaddr));
if afullname='' then
afullname := ' (local, unknown name)'
else
afullname := ', '+afullname;
xwritesss('To: ',replyaddr,afullname)
end
else
xwritess('To: ',replyaddr);
end;
xclreolxy(1,lpp);
xwrites('CC: ');
xreadlnse(ccaddr,cols-10,nopreserve,endkeyswithspace);
ccaddr := expandmail(ccaddr);
xclreolxy(1,lpp);
if replyaddr<>getfromaddr(artfrom) then
originalfrom := artfrom
else
originalfrom := '';
editanddeliver(
{subject } subject,
{inreplyto } inreplyto,
{replyaddr } replyaddr,
{replyname } replyname,
{ccaddr } ccaddr,
{originalfrom } originalfrom,
{author } author,
{defaultreply } defaultreply,
{includedfile } '',
{justremail } false
);
artreset;
{leave refresh to caller}
end;
procedure replytoart;
begin
if not maymail then
begin
warn('you may not mail -- check your configuration');
browserefresh;
end
else
actuallyreplytoart;
end;
procedure actuallymailart;
var
subject: string;
inreplyto: string;
mailaddr: string;
author: string;
ccaddr: string;
afullname: string;
begin
artclose;
subject := artsubject;
inreplyto := artmessageid;
author := getheaderline(artfn,'reply-to:');
if not isreasonableaddress(author) then
author := '';
if author='' then
author := artfrom;
if author='' then
author := '<unknown>';
{`sender' isn't legal, but I've seen it}
if (author='poster') or (author='sender') then
author := artfrom;
if not isreasonableaddress(author) then
if isreasonableaddress(bodyaddress) then
author := bodyaddress;
author := getfromaddr(author);
xclreolxy(1,lpp);
xwrites('Mail To: ');
xreadlnse(mailaddr,cols-15,nopreserve,endkeyswithspace);
if mailaddr='' then
mailaddr := mailfrom;
mailaddr := expandmail(mailaddr);
if not quiet then
begin
xclreolxy(1,lpp-1);
xclreolxy(1,lpp-2);
if (pos('!',mailaddr)=0) and
(pos('@',mailaddr)=0) and
(pos(',',mailaddr)=0) then
begin
afullname := getfullnameforuser(lower(mailaddr));
if afullname='' then
afullname := ' (local, unknown name)'
else
afullname := ', '+afullname;
xwritesss('To: ',mailaddr,afullname)
end
else
xwritess('To: ',mailaddr);
end;
xclreolxy(1,lpp);
xwrites('CC: ');
xreadlnse(ccaddr,cols-10,nopreserve,endkeyswithspace);
ccaddr := expandmail(ccaddr);
xclreolxy(1,lpp);
editanddeliver(
{subject } subject,
{inreplyto } inreplyto,
{replyaddr } mailaddr,
{replyname } '',
{ccaddr } ccaddr,
{originalfrom } '',
{author } author,
{defaultreply } false,
{includedfile } '',
{justremail } true
);
artreset;
{leave refresh to caller}
end;
procedure mailart;
begin
if not maymail then
begin
warn('you may not mail -- check your configuration');
browserefresh;
end
else
actuallymailart;
end;
procedure browsecopytofolder;
var
folder: string;
folderdir: string;
oldlastline: integer;
begin
if not quiet then
begin
xclreolxy(1,lpp-3);
xclreolxy(1,lpp-2);
xwritelns('Enter a folder (e.g., `=misc'') as a destination for');
xclreolxy(1,lpp-1);
xwritelns('this article, or leave blank to abort');
end;
folder := lastfolder;
xclreolxy(1,lpp);
xwrites('Copy to Folder: ');
xreadlnse(folder,max(cols-20,70),yespreserve,endkeyswithspace);
xclreolxy(1,lpp);
if (folder<>'') and (numoccur('\',unslash(folder))=0) and
(numoccur(':',folder)=0) and (pos('..',folder)=0) then
begin
if folder[1]<>'=' then
folder := '='+folder;
lastfolder := folder;
xwritesss('Copying to ',folder,'...');
unfoldergroup(folder);
if not joinedtoexactgroup(folder) then
addnewmailgroup(folder);
folderdir := getgroupdir(folder);
mkhier(folderdir);
oldlastline := lastlineshown;
artclose;
copyfile(artfn,getuniqfile(folderdir));
artreset;
lastlineshown := oldlastline;
end;
browserefresh;
end;
procedure actuallymovetofolder(folder: string);
var
folderdir: string;
begin
if folder[1]<>'=' then
folder := '='+folder;
if folder<>'=trash' then
lastfolder := folder;
xwritesss('Moving to ',folder,'...');
unfoldergroup(folder);
if not joinedtoexactgroup(folder) then
addnewmailgroup(folder);
folderdir := getgroupdir(folder);
mkhier(folderdir);
artclose;
copyfilethenempty(artfn,getuniqfile(folderdir));
{$ifdef if_you_delete_the_file_you_have_to_be_way_more_careful}
movefile(artfn,getuniqfile(folderdir));
{ if #3 is the highest-numbered, and you move #3, it'd mess up your }
{ join file. perhaps it just should just re-enter the group somehow? }
{ or go through the data structures, removing any evidence of this }
{ article (harder when there's more than one!) }
if (artfn=getuniqfile(folderdir)) and willupdatej then
begin
warn('join file will not be updated for this group');
willupdatej := false;
end;
{$endif}
moreselecting := true;
donebrowse := true;
end;
procedure browsemovetofolder;
var
folder: string;
folderdir: string;
begin
if not ismailgroup(currsource) then
begin
warn('not a mail group -- using Copy instead');
browsecopytofolder;
end
else
begin
if not quiet then
begin
xclreolxy(1,lpp-3);
xclreolxy(1,lpp-2);
xwritelns('Enter a folder (e.g., `=misc'') as a destination for');
xclreolxy(1,lpp-1);
xwritelns('this article, or leave blank to abort');
end;
folder := lastfolder;
xclreolxy(1,lpp);
xwrites('Move to Folder: ');
xreadlnse(folder,max(cols-20,70),yespreserve,endkeyswithspace);
xclreolxy(1,lpp);
if (folder<>'') and (numoccur('\',unslash(folder))=0) and
(numoccur(':',folder)=0) and (pos('..',folder)=0) then
begin
actuallymovetofolder(folder);
end
else
begin
browserefresh;
end;
end;
end;
procedure browsedeletemail;
var
deleteoops: char;
begin
if not ismailgroup(currsource) then
begin
warn('not a mail group -- cannot delete');
browserefresh;
end
else
begin
xclreolxy(1,lpp-1);
deleteoops := onekeydef('{d}elete (move to =trash), {o}ops','do','o');
xclreolxy(1,lpp);
if deleteoops='o' then
browserefresh
else
actuallymovetofolder('trash');
end;
end;
procedure followtoart(newfollowupto: string);
var
followupto: string;
newsgroups: string;
originalnewsgroups: string;
originalauthor: string;
shouldmail: boolean;
shouldfollow: boolean;
replyfollow: char;
subject: string;
messageid: string;
references: string;
inreplyto: string;
author: string;
refline: string;
ref1, ref2: string;
mightbearef: string;
begin
xclreolxy(1,lpp);
xwrites('Follow...');
artclose;
followupto := getheaderline(artfn,'followup-to:');
newsgroups := artnewsgroups;
originalnewsgroups := newsgroups;
{`sender' isn't legal, but I've seen it}
shouldfollow := true;
shouldmail := (followupto='poster') or (followupto='sender') or
(pos('@',followupto)<>0) or (pos('!',followupto)<>0) or
(pos('%',followupto)<>0);
if shouldmail or
(currsourcekind<>sourcegroup) or
ismailgroup(currsource) then
begin
followupto := newsgroups;
xclreolxy(1,lpp-2);
xclreolxy(1,lpp-1);
if ismailgroup(currsource) then
xwritelns('this is a private mail folder.')
else if currsourcekind<>sourcegroup then
xwritelns('this is not a real newsgroup.')
else
xwritelns('author seemed to want replies by mail only.');
replyfollow :=
onekey('{r}eply by mail, {f}ollowup anyway, {q}uit','rfq');
if replyfollow='r' then
xwrites('reply...')
else if replyfollow='f' then
xwrites('follow...');
shouldmail := (replyfollow='r');
shouldfollow := (replyfollow='f');
end;
if not maypost then
shouldmail := true;
if shouldmail then
begin
artreset; {replytoart closes it immediately}
replytoart;
end
else if shouldfollow then
begin
{ don't propogate errors in the Newsgroups: line if you can help it }
newsgroups := unspace(newsgroups);
followupto := unspace(followupto);
{ignore Followup-To: when supplying new followup group explicitly}
if newfollowupto<>'' then
followupto := '';
if followupto='' then
begin
followupto := newsgroups;
followupto := default(newfollowupto,followupto);
followupto := default(currsource,followupto);
end
else
begin
{ give the user a warning, to avoid blind Followup-To: misc.test,talk.bizarre }
if followupto<>newsgroups then
warn('followups have been changed');
end;
{followups redirected to /dev/null - but there are some local groups}
{with no . -- but there shouldn't be, since crossposting is a pain then}
if pos('.',followupto)=0 then
begin
warn('new groups list has no `.'' -- looks suspicious');
end;
{ always warn again if there's a .test group in user's post }
if pos( '.test,' , followupto+',' )<>0 then
begin
warn3
(
'there is a .test group on this post -- it may result in',
'you getting a lot of automated mail from around the world.',
'remove it unless you _really_ know what you are doing.'
);
end;
{}{}{} {should warn user if there are unknown groups that might be errors}
{}{}{} {should do each group individually!}
if newfollowupto<>'' then
if newfollowupto<>'poster' then
if pos(','+newfollowupto+',',','+followupto+',')=0 then
followupto := followupto+','+newfollowupto;
{currsource isn't necessarily even in the followupto list, so don't warn}
{about moderation when people post followups to, say,}
{news.announce.newgroups where followups are always redirected to news.groups}
{}{}{} {should check if _any_ group in the list is moderated, and give warning}
if pos(','+currsource+',',','+followupto+',')<>0 then
if ismoderated(currsource) then
warn('this group is moderated');
{}{}{} {should check if _any_ of the groups is marked as /solo => strip it out}
if groupbattr(currsource,'/solo') and (pos(',',followupto)<>0) then
begin
warn('warning: /solo group - crosspost removed');
followupto := currsource;
end;
{ warn on 5 or more groups, suggest followupto of first group }
{ but don't overwrite previous :follow direction! }
if (numoccur(',',followupto)>3) and (newfollowupto='') then
begin
warn('massive crossposting--edit or delete the Followup-To: line');
newfollowupto := copy(followupto,1,pos(',',followupto)-1);
if currsourcekind=sourcegroup then
if pos(','+currsource+',' , ','+followupto+',')<>0 then
newfollowupto := currsource;
end;
subject := artsubject;
subject := 'Re: '+nore(subject);
messageid := artmessageid;
references := getheaderline(artfn,'references:');
{Andrew system non-compliance, looks like}
inreplyto := getheaderline(artfn,'in-reply-to:');
inreplyto := getfirstw(inreplyto);
if length(references)+length(inreplyto)<250 then
if enclosedin(inreplyto,'<','>') then
if pos(inreplyto,references)=0 then
references := references+' '+inreplyto;
author := getheaderline(artfn,'reply-to:');
{`sender' isn't legal, but I've seen it}
if (author='poster') or (author='sender') then
author := '';
if (author<>'') and (pos('!',author)=0) and (pos('@',author)=0) then
begin
warn('invalid Reply-To: - using From:');
author := '';
end;
if author='' then
author := getheaderline(artfn,'from:');
{handle case where Reply-To: is same as From:, but without name - keep the}
{name if you can}
if getfromname(author)='' then
if upper(author)=upper(getfromaddr(artfrom)) then
if getfromname(artfrom)<>'' then
author := getfromaddr(author)+' ('+getfromname(artfrom)+')';
originalauthor := '';
if getfromaddr(author)<>getfromaddr(artfrom) then
originalauthor := artfrom;
{ special-casing in getheaderline() makes sure we get the last few }
{ references always. well, except on >255 char References: lines }
ref1 := '';
ref2 := '';
refline := references;
ref1 := chopfirstw(refline);
if not enclosedin(ref1,'<','>') then
ref1 := '';
if refline<>'' then
begin
ref2 := chopfirstw(refline);
if not enclosedin(ref2,'<','>') then
ref2 := '';
end;
while numoccur('>',refline)>0 do
begin
mightbearef := chopfirstw(refline);
if enclosedin(mightbearef,'<','>') then
begin
if ref2<>'' then
ref1 := ref2;
ref2 := mightbearef;
end;
end;
refline := '';
if ref1<>'' then
refline := refline+ref1+' ';
if ref2<>'' then
refline := refline+ref2+' ';
refline := refline+messageid;
createpost(followupto,originalnewsgroups,newfollowupto,subject,
refline,author,originalauthor,'');
editandinjnews(followupto,originalnewsgroups,author);
end;
artreset;
browserefresh;
end;
procedure follow;
var
newfollowupto: string;
begin
if not maypost then
begin
warn('you do not have access to post this way');
browserefresh;
end
else
begin
newfollowupto := internalcmdlineparams;
if newfollowupto='' then
newfollowupto := currsource;
xclreolxy(1,lpp);
xwrites('Followup-To: ');
xreadlnse(newfollowupto,max(cols-20,70),yespreserve,endkeyswithspace);
if newfollowupto='' then
newfollowupto := currsource;
{possibly expand the group}
{explicitly does not expand to a mail folder -- that wouldn't make sense}
{neither expand the magic word `poster'}
{}{}{} {should expand _each_ group separately}
if newfollowupto<>'poster' then
if numoccur(',',newfollowupto)=0 then
if not isavalidgroup(newfollowupto) then
if joinedtogroup(newfollowupto) then
;
followtoart(newfollowupto);
{followtoart does a browserefresh}
end;
end;
procedure cancel;
var
yn: char;
newsubj: string;
begin
if not (trusted and maypost) then
begin
warn('you do not have access to cancel posts');
end
else
begin
xclreolxy(1,lpp-8);
xclreolxy(1,lpp-7);
xwritelnss(' you are: ',newsfrom);
xclreolxy(1,lpp-6);
xwritelnss('this article from: ',artfrom);
xclreolxy(1,lpp-5);
xclreolxy(1,lpp-4);
if newsfrom=artfrom then
xwritelns('(looks the same)')
else
xwritelns('NOT THE SAME!');
xclreolxy(1,lpp-3);
xclreolxy(1,lpp-2);
xwritelns('cancel will remove this article from every system');
xclreolxy(1,lpp-1);
xwritelns('world-wide. do not do this unless authorized.');
xclreolxy(1,lpp);
yn := onekeydef('are you SURE you are authorized {Y}/{n}',
'Yn','n');
if yn='Y' then
begin
newsubj := 'cmsg cancel '+artmessageid;
createcancel(artnewsgroups,newsubj,artmessageid,artfrom);
editandinjnews(artnewsgroups,'','');
end;
end;
{caller must refresh}
end;
procedure killart;
var
subjectfromoops: char;
whichart: integer;
killstring: string;
begin
subjectfromoops := onekeydef(
'kill: this group: {s}ubject {f}rom; always {S}ubject {F}rom; {o}ops',
'sfSFo','o');
if (subjectfromoops<>'o') and (currsourcekind<>sourcegroup) then
begin
if subjectfromoops<>upcase(subjectfromoops) then
warn('only global kills can be done from here');
subjectfromoops := upcase(subjectfromoops);
end;
if subjectfromoops<>'o' then
begin
if (subjectfromoops='s') or (subjectfromoops='S') then
begin
xwrites(cr);
xclreol;
killstring := articles[artnum]^.basesubject;
xwrites('Working...');
addtokill('Subject',killstring,(subjectfromoops='S'));
{}{} {overrides antikill-even-killed!}
{too much checking here - won't hurt anything but the clock}
for whichart := 1 to numarts do
if selected[whichart] then
if artkilled(articles[whichart]^.basesubject,
articles[whichart]^.from,'',artfn) then
setselected(whichart,false);
xwrites(cr);
xclreol;
end
else
begin
xwrites(cr);
xclreol;
xwrites('Working...');
killstring := getfromaddr(artfrom);
addtokill('From',killstring,(subjectfromoops='F'));
{}{} {overrides antikill-even-killed!}
{too much checking here - won't hurt anything but the clock}
for whichart := 1 to numarts do
if selected[whichart] then
if artkilled(articles[whichart]^.basesubject,
articles[whichart]^.from,'',artfn) then
setselected(whichart,false);
xwrites(cr);
xclreol;
end;
donebrowse := true;
end;
if not quiet then
selrefreshbotline;
end;
procedure antikillart;
var
subjectfromoops: char;
whichart: integer;
antikillstring: string;
begin
subjectfromoops := onekeydef(
'antikill: this group: {s}ubject {f}rom; always {S}ubject {F}rom; {o}ops',
'sfSFo','o');
if (subjectfromoops<>'o') and (currsourcekind<>sourcegroup) then
begin
if subjectfromoops<>upcase(subjectfromoops) then
warn('only global antikills can be done from here');
subjectfromoops := upcase(subjectfromoops);
end;
if subjectfromoops<>'o' then
begin
if (subjectfromoops='s') or (subjectfromoops='S') then
begin
xwrites(cr);
xclreol;
xwrites('Working...');
antikillstring := articles[artnum]^.basesubject;
addtoantikill('Subject',antikillstring,(subjectfromoops='S'));
{too much checking here - won't hurt anything but the clock}
for whichart := 1 to numarts do
if artantikilled(articles[whichart]^.basesubject,
articles[whichart]^.from,'',artfn) then
begin
setselected(whichart,true);
articles[whichart]^.indents :=
articles[whichart]^.indents or 128;
end;
xwrites(cr);
xclreol;
end
else
begin
xwrites(cr);
xclreol;
xwrites('Working...');
antikillstring := getfromaddr(artfrom);
addtoantikill('From',antikillstring,(subjectfromoops='F'));
{too much checking here - won't hurt anything but the clock}
for whichart := 1 to numarts do
if artantikilled(articles[whichart]^.basesubject,
articles[whichart]^.from,'',artfn) then
begin
setselected(whichart,true);
articles[whichart]^.indents :=
articles[whichart]^.indents or 128;
end;
xwrites(cr);
xclreol;
end;
end;
if not quiet then
selrefreshbotline;
end;
procedure toggleheaders;
begin
showallheaders := not showallheaders;
firstemptyline := maxint;
rewindtopline(0);
end;
procedure rereadkillfiles;
begin
readinkill(nobackupkill);
readinantikill(nobackupkill);
browserefresh;
end;
procedure quitbrowsenoupdate;
var
doit: boolean;
begin
doit := true;
if confirmquit then
doit := (onekey('are you SURE you want to quit? {y}/{n}','yn')='y');
if not doit then
browserefresh
else
begin
xwriteln;
if willupdatej then
xwritelnss('quitting without updating join file for ',currsource);
xwriteln;
donebrowse := true;
donegroup := true;
if willupdatej then
begin
currsource := '';
needtofindnextgroup := false;
willupdatej := false;
end;
end;
end;
procedure nextgroupnoupdate;
var
doit: boolean;
begin
doit := true;
if confirmnextgroup then
doit := (onekey(
'are you SURE you want to jump directly to the next group? {y}/{n}',
'yn')='y');
if doit then
begin
if willupdatej then
begin
xwriteln;
xwritelns('join file not updated');
xwriteln;
willupdatej := false;
end;
donebrowse := true;
donegroup := true;
end
else
browserefresh;
end;
{}{} {might want to start at top of screen for this?}
procedure browsesearchnext;
var
s: string;
foundatline: integer;
oldlastline: integer;
begin
if arteof then
browserefresh
else
begin
xclreolxy(1,lpp);
xwrites('Searching...');
oldlastline := lastlineshown;
foundatline := -1;
while not arteof and (foundatline<0) do
begin
getartl(s,cols-1,yestoscreen);
inc(lastlineshown);
{doesn't catch strings split over when you have long, wrapped lines! }
{ but this is not a big problem when breaking at work boundaries }
if textintext(browseuppersearchstring,upper(s)) then
foundatline := lastlineshown;
end;
if foundatline<0 then
begin
warn('not found past this screen');
lastlineshown := oldlastline;
browserefresh;
end
else
rewindtopline(foundatline-2);
end;
end;
procedure browsesearch;
var
newsearchstring: string;
begin
xclreolxy(1,lpp);
xwrites('/');
xreadlns(newsearchstring,max(cols-4,76),nopreserve);
if newsearchstring<>'' then
browseuppersearchstring := upper(newsearchstring);
if browseuppersearchstring='' then
browserefresh
else
begin
highlightsearchhits := true;
browsesearchnext;
end;
end;
procedure browsesearchagain;
begin
if browseuppersearchstring<>'' then
begin
highlightsearchhits := true;
browsesearchnext;
end;
end;
procedure searchdigest;
var
s: string;
foundatline: integer;
oldlastline: integer;
begin
if arteof then
donebrowse := true
else
begin
oldlastline := lastlineshown;
foundatline := -1;
while not arteof and (foundatline<0) do
begin
getartl(s,cols-1,yestoscreen);
inc(lastlineshown);
if pos('--------',s)=1 then
foundatline := lastlineshown;
end;
if foundatline<0 then
begin
warn('no more digest markers found');
lastlineshown := oldlastline;
browserefresh;
end
else
rewindtopline(foundatline-2);
end;
end;
procedure viewart;
begin
if trusted then
begin
xclreolxy(1,lpp);
xwritelns('running '+viewcommand+'...');
mouseshutdown;
execviacomspec(viewcommand+' '+artfn);
{}{}{}{}{ignore execresult?}
mouseinit;
browserefresh;
end;
end;
procedure extractart;
begin
{
warn('extract not yet completed...');
finfoheader := getheaderline(artfn,'x-finfo:');
if finfoheader='' then
warn('no X-Finfo: header found');
warn('X-Finfo: header is '+finfoheader);
}
if trusted then
begin
xclreolxy(1,lpp);
xwritelns('running '+extractcommand+'...');
mouseshutdown;
execviacomspec(extractcommand+' '+artfn);
{}{}{}{}{ignore execresult?}
mouseinit;
browserefresh;
end;
end;
procedure printart;
begin
if trusted then
begin
xclreolxy(1,lpp);
xwritelns('running '+printcommand+'...');
mouseshutdown;
execviacomspec(printcommand+' '+artfn);
{}{}{}{}{ignore execresult?}
mouseinit;
browserefresh;
end;
end;
procedure browsecommand;
var
commandline: string;
commandverb: string;
begin
xclreolxy(1,lpp);
xwrites(':');
xreadlns(commandline,max(cols-4,76),nopreserve);
internalcmdlineparams := commandline;
commandverb := lower(chopfirstw(internalcmdlineparams));
if commandline='' then
browserefresh
else
begin
if partialmatch(commandverb,'help','h') then
browsehelppage
else if partialmatch(commandverb,'?','?') then
browsehelppage
else if partialmatch(commandverb,'next','n') then
donebrowse := true
else if partialmatch(commandverb,'postfile','postf') then
begin postfile; browserefresh; end
else if partialmatch(commandverb,'post','p') then
begin post; browserefresh; end
else if partialmatch(commandverb,'mailfile','mailf') then
begin mailfile; browserefresh; end
else if partialmatch(commandverb,'mail','m') then
begin mail; browserefresh; end
else if partialmatch(commandverb,'follow','f') then
follow
else if partialmatch(commandverb,'cancel','can') then
begin cancel; browserefresh; end
{ugh} else if partialmatch(commandverb,'print','pr') then
printart
else if partialmatch(commandverb,'set','set') then
begin
justhandleset(internalcmdlineparams,issuspicious);
browserefresh;
end
else if partialmatch(commandverb,'unset','unset') then
begin
justhandleunset(internalcmdlineparams,issuspicious);
browserefresh;
end
else if partialmatch(commandverb,'show','sho') then
begin
usershow(internalcmdlineparams);
browserefresh;
end
else if partialmatch(commandverb,'version','v') then
begin
showversion;
browserefresh;
end
else if partialmatch(commandverb,'quit','q') then
quitbrowsenoupdate
else
begin
warn('unrecognized command');
browserefresh;
end;
end;
end;
procedure geteopkey;
var
ch: char;
needakey: boolean;
dataline: string;
throughart: real;
footermousechars: string;
begin
footermousechars := '=<>npu^$''';
if hasmouse then
footermousechars := ' '+footermousechars+' '
else
footermousechars := '';
repeat
needakey := false;
dataline := '--'+currenttimestring+'--?=help'+footermousechars+
'--'+numlefts+'--';
if arteof then
begin
dataline := dataline+'(Bottom)--';
totlines := lastlineshown;
end
else if totlines>0 then
begin
throughart := lastlineshown;
throughart := 100*throughart;
throughart := throughart/totlines;
dataline := dataline+itoa(round(throughart))+'%--';
end;
if length(dataline)+length(currsource)>(cols-6) then
dataline := '--'+
copy(currsource,length(currsource)-((cols-6)-length(dataline)),255)+
dataline
else
dataline := '--'+currsource+dataline;
xwritess(dataline,' ');
ch := xreadkey;
xwrites(^M);
xclreol;
ch := browsemap[ch];
case ch of
'?': browsehelppage;
'n': donebrowse := true;
'p': begin donebrowse := true; browsedir := -1; end;
'a': browseahead;
'b': browseback;
'u': rewindtopline(lastlineshown-lpp-(lpp div 2));
'<': rewindtopline(lastlineshown-lpp-(lpp div 2));
^B : rewindtopline(lastlineshown-lpp-(lpp div 2));
'^': rewindtopline(0);
^A : rewindtopline(0);
'$': showlastline;
^E : showlastline;
^N: morelines(1);
^P: rewindtopline(lastlineshown-lpp);
cr: morelines(1);
' ': morelines(lpp-3);
'>': morelines(lpp-3);
^F : morelines(lpp-3);
'd': morelines(lpp div 2);
'w': begin writeart; needakey := true; browserefresh; end;
's': begin saveart; needakey := true; browserefresh; end;
'r': begin replytoart; needakey := true; browserefresh; end;
'm': begin mailart; needakey := true; browserefresh; end;
'C': begin browsecopytofolder; needakey := true; end;
'M': begin browsemovetofolder; needakey := true; end;
'f': begin followtoart(''); needakey := true; end;
'k': begin killart; needakey := true; browserefresh; end;
'K': begin antikillart; needakey := true; browserefresh; end;
'e': begin editart; needakey := true; end;
'D': begin rot13ing := not rot13ing; browserefresh; end;
'c': begin compactspaces := not compactspaces; browserefresh; end;
'h': toggleheaders;
^L : browserefresh;
^R : begin rereadkillfiles; needakey := true; end;
^D : begin browsedeletemail; needakey := true; end;
'Q': quitbrowsenoupdate;
'N': nextgroupnoupdate;
'!': begin shellout; browserefresh; end;
'=': begin moreselecting := true; donebrowse := true; end;
tab: begin skipsection := true; donebrowse := true; end;
'/': browsesearch;
'.': browsesearchagain;
':': browsecommand;
'A': begin addalias(artfrom); browserefresh; end;
^G : searchdigest;
'v': viewart;
'x': extractart;
else needakey := true;
end; {case}
until donebrowse or not needakey;
end;
begin {browseart}
internalcmdlineparams := '';
bodyaddress := '';
rot13ing := false;
compactspaces := false;
showallheaders := false;
numlefts := itoa(numleft)+' more';
if numleft=0 then
numlefts := 'LAST';
if not willupdatej then
numlefts := numlefts+' (no update)';
newbrowsescreen;
quitatarteof := true;
lastlineshown := 0;
totlines := -1;
sawendofarticle := false;
highlightsearchhits := false;
usingalternatecolor := true; {it gets toggled immediately after headers}
shouldswitchcolor := false;
artfn := withbackslash(currdir)+articles[artnum]^.filename;
assign(artf,artfn);
donebrowse := false; {artreset could change this}
quotechar := '>';
if dotsonreset then
begin
xgotoxy(1,1);
xwrites('...');
end;
if not fexists(artfn) then
begin
artfrom := '(expired)';
artsubject := '(expired)';
artmessageid := '(expired)';
artnewsgroups := '(expired)';
end
else
begin
{don't get from articles[]^.from - need full name _and_ address for kill file}
artfrom := getheaderline(artfn,'from:');
artsubject := getheaderline(artfn,'subject:');
artmessageid := getheaderline(artfn,'message-id:');
artnewsgroups := getheaderline(artfn,'newsgroups:');
{$ifdef charset}
if uselocalcharset then
setreadencoding(
getheaderline(artfn,'content-type:'),
getheaderline(artfn,'content-transfer-encoding:'));
{$endif}
if findquotechar then
quotechar := bestquotechar;
end;
if dotsonreset then
begin
xgotoxy(1,1);
xwrites(' ');
xgotoxy(1,1);
end;
firstemptyline := maxint; {do it here, since bestquotechar changed it}
browserefresh; {does an artreset itself}
while not donebrowse do
begin
{if we've already read off the end of the article, it's time for a new one}
if arteof and quitatarteof then
donebrowse := true
else
begin
{otherwise indicate all has been seen and get a key}
quitatarteof := true;
geteopkey;
end;
end;
artclose;
end;
procedure viewarts(lowest,highest: integer; updatehighestread: boolean);
var
numleft: integer;
whichart: integer;
willupdatej: boolean;
currsubj: subjstringt;
foundselected: boolean;
begin
willupdatej := updatehighestread;
currart := lowest;
donegroup := false;
browsedir := 1;
browseonlysel := true;
while not moreselecting and not donegroup do
begin
if skipsection then
begin
currsubj := articles[currart]^.basesubject;
while
(currart<=highest)
and
subjseq(currsubj,articles[currart]^.basesubject) do
inc(currart);
{short-circuit}
foundselected := false;
while not foundselected do
begin
if currart>highest then
foundselected := true
else if selected[currart] then
foundselected := true
else
inc(currart);
end;
end
else
if browseonlysel then
while (currart>=lowest) and (currart<=highest) and
not selected[currart] do
inc(currart,browsedir);
skipsection := false;
browseonlysel := true;
if currart>highest then
donegroup := true;
if currart<lowest then
browsedir := 1;
if (currart>=lowest) and (currart<=highest) then
begin
browsedir := 1;
{using k/b/a can mess this up any nice and simple way, so do it this way}
{will still show LAST when you're past the last selected one - so what}
numleft := 0;
for whichart := currart+1 to highest do
if selected[whichart] then
inc(numleft);
browseart(currart,numleft,willupdatej);
if (atol(articles[currart]^.filename)>highestread) and
willupdatej then
highestread := atol(articles[currart]^.filename);
end;
{ handle case of going to non-selected-also articles on extremes (first/last) }
{ allow `n' etc. to indicate finished reading, but not `a',`p',`b' }
if ((browsedir>0) or (currart>lowest)) and
(browseonlysel or (browsedir<0) or (currart<highest)) and
not skipsection then
inc(currart,browsedir);
end;
{willupdatej can change to false part way through}
if not willupdatej then
highestread := 0;
end;
procedure selectandbrowse;
var
whichart: integer;
donepagesel: boolean;
donegroupsel: boolean;
selsubjs: array[1..maxlpp] of string;
inkey,lastinkey: char;
lastselected: boolean;
highestlegalsellet: char;
highestlegalseldig: char;
currsourcedesc: string;
selheaderline: string;
function isselchar(ch: char): boolean;
begin
isselchar :=
((ch<=highestlegalsellet) and (islower(ch))) or
((ch<=highestlegalseldig) and (isdigit(ch)));
end;
function selcharnum(ch: char): integer;
begin
if isdigit(ch) then
selcharnum := ord(ch)-ord('0')+1+26
else
selcharnum := ord(ch)-ord('a')+1;
end;
function whichselchar(onetothirtysix: integer): char;
begin
if onetothirtysix<=26 then
whichselchar := chr(ord('a')+(onetothirtysix-1))
else
whichselchar := chr(ord('0')+(onetothirtysix-1)-26);
end;
procedure writetotalselln(lineno: integer; c: char);
var
subjwidth: integer;
ycoord: integer;
printsubj: string;
countindents: integer;
stringedsize: string;
lensofar: integer;
showndate: string;
nondatecolor: byte;
begin
lensofar := 0;
showndate := dateformat;
if showndate='-' then
showndate := '';
if showndate<>'' then
showndate := showndate+' ';
subjwidth := max(1,cols-1-(4+fromwidth+sizewidth+1+length(showndate)));
if selected[lineno] then
nondatecolor := highcolor
else if odd(lineno) then
nondatecolor := lowcolor
else
nondatecolor := alternatecolor;
xsetcolor(nondatecolor);
ycoord := lineno-topline+1+selheaderlines+1;
{other code keeps lineno-topline<36}
writexy(1,ycoord,whichselchar(lineno-topline+1));
inc(lensofar);
xwrites(c);
inc(lensofar);
if layout=layoutnormal then
begin
xwrites(nonastychar(copy(articles[lineno]^.from,1,fromwidth)));
inc(lensofar,fromwidth);
{fromwidth is always>0}
xwrites(' ');
inc(lensofar);
end;
{$ifdef testsort}
if showdebug('sort') then
writexy(3,ycoord,articles[lineno]^.filename+' ');
{$endif}
stringedsize := itoa(articles[lineno]^.sizeink);
if articles[lineno]^.sizeink=255 then
stringedsize := 'huge';
{length is guaranteed to be 4 or less}
if length(stringedsize)>sizewidth then
begin
if sizewidth<1 then
stringedsize := ''
else if sizewidth=1 then
stringedsize := '!'
else if sizewidth=2 then
stringedsize := 'lg'
else if sizewidth=3 then
stringedsize := 'big';
end;
xgotoxy(1+lensofar,ycoord);
xwritesw(stringedsize,sizewidth);
inc(lensofar,sizewidth);
xwrites(' ');
inc(lensofar);
if (layout=layoutnormal) and (showndate<>'') then
begin
showndate :=
dateformatted(articles[lineno]^.date div 16384,
(articles[lineno]^.date mod 16384) div 1024,
(articles[lineno]^.date mod 1024) div 32,
dateformat);
showndate := showndate+' ';
if datecolor<>255 then
xsetcolor(datecolor);
xwrites(showndate);
inc(lensofar,length(showndate));
if datecolor<>255 then
xsetcolor(nondatecolor);
end;
printsubj := '';
for countindents := 1 to (articles[lineno]^.indents and $f) do
printsubj := printsubj+'>';
printsubj := printsubj+selsubjs[lineno-topline+1];
printsubj := nonastychar(printsubj);
xgotoxy(1+lensofar,ycoord);
if printsubj='' then
xwrites('-')
else if layout=layoutnormal then
xwrites(copy(printsubj,1,subjwidth))
else
xwrites(copy(printsubj,1,max(subjwidth,cols-lensofar-2)));
if nondatecolor<>lowcolor then
xsetcolor(lowcolor);
xgotoxy(1,sellpp+selheaderlines+4);
end;
procedure clearstar;
begin
if starbeside<>0 then
begin
writexy(2,starbeside-topline+1+selheaderlines+1,' ');
starbeside := 0;
end;
end;
procedure writeselln(lineno: integer);
begin
clearstar;
writetotalselln(lineno,' ');
end;
procedure writesellnstar(lineno: integer);
begin
clearstar;
writetotalselln(lineno,'*');
starbeside := lineno;
end;
procedure setupselheaderline;
begin
selheaderline := '';
{$ifdef old}
if not hasmouse then
xwritessis(currsource,' Articles: ',numarts,' ')
else
begin
xwritess(currsource,' ');
xwrites(mousecharsheader);
xwrites(' Articles: ');
xwritei(numarts);
xclreol;
end;
{$endif}
if not hasmouse then
selheaderline := currsource
else
selheaderline := currsource+' '+mousecharsheader+' ';
selheaderline := selheaderline+' Articles: '+ltoa(numarts);
if length(selheaderline)<cols-6 then
begin
selheaderline := selheaderline+' ';
while length(selheaderline)+length(currsourcedesc)<cols-4 do
selheaderline := selheaderline+' ';
selheaderline := selheaderline+
copy(currsourcedesc,1,cols-length(selheaderline)-1);
end;
end;
procedure selrefresh;
var
whichart: integer;
prevsubj: subjstringt;
begin
prevsubj := '';
xclrscr;
xgotoxy(1,1);
xwrites(selheaderline);
xclreol;
botline := topline-1;
for whichart := topline to min(topline+sellpp-1,numarts) do
begin
if subjseq(articles[whichart]^.basesubject,prevsubj) then
selsubjs[whichart-topline+1] := ''
else
selsubjs[whichart-topline+1] := articles[whichart]^.basesubject;
prevsubj := articles[whichart]^.basesubject;
writeselln(whichart);
botline := whichart;
end;
selrefreshbotline;
{there will always be at least one letter, but not always any digits}
highestlegalsellet := 'z';
highestlegalseldig := chr(ord('0')-1); {i.e., none are legal}
if botline-topline<26 then
highestlegalsellet := whichselchar(botline-topline+1)
else
highestlegalseldig := whichselchar(botline-topline+1);
end;
procedure togglekey(inkey: char);
var
artnum: integer;
begin
artnum := topline+selcharnum(inkey)-1;
if artnum<=botline then
begin
setselected(artnum,not selected[artnum]);
lastselected := selected[artnum];
if hasmouse and selected[artnum] then
writesellnstar(artnum)
else
writeselln(artnum)
end;
if not quiet then
selrefreshbotline;
end;
procedure selreversepage;
var
artnum: integer;
begin
for artnum := topline to botline do
begin
setselected(artnum,not selected[artnum]);
writeselln(artnum);
end;
if not quiet then
selrefreshbotline;
end;
procedure selselectornotall(selected: boolean); {caller must refresh}
var
artnum: integer;
begin
for artnum := 1 to numarts do
setselected(artnum,selected);
end;
procedure selselectall; {caller must refresh}
begin
selselectornotall(true);
end;
procedure selclearall; {caller must refresh}
begin
selselectornotall(false);
end;
procedure dostar(inkey: char);
var
artnum: integer;
currsubj: subjstringt;
begin
artnum := topline+selcharnum(inkey)-1;
currsubj := articles[artnum]^.basesubject;
while
(artnum<=numarts)
and
subjseq(currsubj,articles[artnum]^.basesubject) do
begin
if selected[artnum]<>lastselected then
begin
setselected(artnum,lastselected);
if artnum<=botline then
writeselln(artnum);
end;
inc(artnum);
end;
if not quiet then
selrefreshbotline;
end;
procedure dodash(inkey: char);
var
inkeyint: integer;
artnum: integer;
newkey: char;
newkeyint: integer;
begin
inkeyint := selcharnum(inkey)-1;
xclreolxy(1,lpp);
xwritess(inkey,'-');
newkey := xreadkeyextended(0,0,
2+selheaderlines,(botline-topline)+2+selheaderlines);
newkey := selmap[newkey];
if isselchar(newkey) then
begin
newkeyint := selcharnum(newkey)-1;
if (newkeyint<botline-topline+1) and (newkeyint>=inkeyint) then
for artnum := topline+inkeyint+1 to topline+newkeyint do {+1=togl once}
begin
if selected[artnum]<>lastselected then
begin
setselected(artnum,lastselected);
writeselln(artnum);
end;
end;
end;
xclreolxy(1,lpp);
if not quiet then
selrefreshbotline;
end;
procedure backpage;
begin
if (topline<>1) or (botline<>numarts) then
begin
if topline=1 then
topline := numarts-((numarts-1) mod sellpp)
else
dec(topline,sellpp);
selrefresh;
end;
end;
procedure forwardpage;
begin
if (topline<>1) or (botline<>numarts) then
begin
if botline=numarts then
topline := 1
else
inc(topline,sellpp);
selrefresh;
end;
end;
procedure firstpage;
begin
if topline<>1 then
begin
topline := 1;
selrefresh;
end;
end;
procedure lastpage;
begin
if botline<>numarts then
begin
topline := numarts-((numarts-1) mod sellpp);
selrefresh;
end;
end;
procedure browseandreturn;
var
anyselected: boolean;
currart: integer;
begin
anyselected := false;
for currart := topline to botline do
if selected[currart] then
anyselected := true;
if anyselected then
begin
viewarts(topline,botline,false);
{ if hit `=', don't reset selected[] }
if not moreselecting then
for currart := topline to botline do
if selected[currart] then
setselected(currart,false);
if currsource<>'' then
selrefresh;
end;
moreselecting := false;
end;
procedure savewritehighlightedarts(fullheaders: boolean);
var
thisallforgetit: char;
lowart, highart: integer;
anyselected: boolean;
currart: integer;
outfilen: string;
outfile: text;
outfileisopen: boolean;
illegal: boolean;
doit: boolean;
appendoverwriteforgetit: char;
infn: string;
inf: text;
firstart: boolean;
s: string;
{$ifdef charset}
yn: char;
foundblank: boolean;
saveusinglocal: boolean;
{$endif}
begin
thisallforgetit := 'a';
{don't ask unless there's more than one page}
if (topline<>1) or (botline<>numarts) then
begin
if fullheaders then
thisallforgetit := onekeydef(
'Save: {t}his page, {a}ll pages, {f}orget it','taf','f')
else
thisallforgetit := onekeydef(
'Write: {t}his page, {a}ll pages, {f}orget it','taf','f');
end;
if thisallforgetit='t' then
begin
lowart := topline;
highart := botline;
end
else
begin
lowart := 1;
highart := numarts;
end;
anyselected := false;
for currart := lowart to highart do
if selected[currart] then
anyselected := true;
if not anyselected and (thisallforgetit<>'f') then
begin
warn('none selected');
thisallforgetit := 'f';
end;
if thisallforgetit<>'f' then
begin
getfilename(outfilen,'file name (blank to abort):',lastfilen);
outfilen := ltrim(trim(outfilen));
if outfilen<>'' then
lastfilen := outfilen;
if tildehome then
if copy(outfilen,1,2)='~/' then
outfilen := home+copy(outfilen,2,255);
outfilen := unslash(outfilen);
illegal := illegalfn(outfilen);
doit := (outfilen<>'');
if doit and not trusted then
begin
illegal := suspiciousfn(outfilen);
end;
if doit and illegal then
begin
warn('unable to use that filename');
end;
if doit and not illegal then
begin
if not trusted then
outfilen := withbackslash(home)+outfilen;
appendoverwriteforgetit := 'o';
if fexists(outfilen) then
begin
xclreolxy(1,lpp);
appendoverwriteforgetit :=
onekeydef('{O}verwrite {a}ppend {f}orget it','Oaf','f');
end;
if appendoverwriteforgetit<>'f' then
begin
{$ifdef charset}
saveusinglocal := false;
if uselocalcharset then
begin
yn := onekey('Use local charset {y}/{n}','yn');
saveusinglocal := (yn = 'y');
end;
{$endif}
outfileisopen := false;
assign(outfile,outfilen);
if appendoverwriteforgetit='a' then
begin
{$I-}
append(outfile);
{$I+}
if ioresult<>0 then
begin
warn('could not append to '+outfilen);
end
else
begin
outfileisopen := true;
writeln(outfile);
writeln(outfile,outputseparator);
writeln(outfile);
end;
end
else
begin
{$I-}
rewrite(outfile);
{$I+}
if ioresult<>0 then
begin
warn('could not write to '+outfilen);
end
else
begin
outfileisopen := true;
end;
end;
firstart := true;
{the outfileisopen test is inside the loop since it was added later, and}
{this is the least painful formatting-wise way to do it...}
for currart := lowart to highart do
if outfileisopen and selected[currart] then
begin
xclreolxy(1,lpp);
xwritesss('Working on ',articles[currart]^.filename,'...');
infn := withbackslash(currdir)+articles[currart]^.filename;
{$ifdef charset}
if (uselocalcharset and saveusinglocal) then
setreadencoding(
getheaderline(infn,'content-type:'),
getheaderline(infn,'content-transfer-encoding:'));
{$endif}
safereset(inf,infn);
if fileresult<>0 then
warn('could not open '+infn)
else
begin
if not firstart then
begin
writeln(outfile);
writeln(outfile,outputseparator);
writeln(outfile);
end;
firstart := false;
{$ifdef charset}
foundblank:= false;
{$endif}
while not eof(inf) do
begin
{need to check fullheaders here!}
{}{}{} {currently, this chops lines at 255 characters! would need:}
{}{}{} {while not eoln read(inf,s); write(outf,s); readln(inf);writeln(outf);}
readln(inf,s);
{$ifdef charset}
if foundblank and saveusinglocal then
linetolocal(s)
else
if s='' then
foundblank := true;
{$endif}
writeln(outfile,s);
end;
close(inf);
end;
end;
if outfileisopen then
close(outfile);
end; {appendoverwriteforgetit}
end; {doit and not illegal}
end; {thisallforgetit}
selrefresh;
end;
procedure writehighlightedarts;
begin
savewritehighlightedarts(nofullheaders);
end;
procedure savehighlightedarts;
begin
savewritehighlightedarts(yesfullheaders);
end;
procedure copyhighlightedarts;
var
folder: string;
folderdir: string;
thisallforgetit: char;
lowart, highart: integer;
anyselected: boolean;
currart: integer;
infn: string;
begin
thisallforgetit := 'a';
{don't ask unless there's more than one page}
if (topline<>1) or (botline<>numarts) then
thisallforgetit := onekeydef(
'Copy: {t}his page, {a}ll pages, {f}orget it','taf','f');
if thisallforgetit='t' then
begin
lowart := topline;
highart := botline;
end
else
begin
lowart := 1;
highart := numarts;
end;
anyselected := false;
for currart := lowart to highart do
if selected[currart] then
anyselected := true;
if not anyselected and (thisallforgetit<>'f') then
begin
warn('none selected');
thisallforgetit := 'f';
end;
if thisallforgetit<>'f' then
begin
if not quiet then
begin
xclreolxy(1,lpp-3);
xclreolxy(1,lpp-2);
xwritelns('Enter a folder (e.g., `=misc'') as a destination for');
xclreolxy(1,lpp-1);
xwritelns('these articles, or leave blank to abort');
end;
folder := lastfolder;
xclreolxy(1,lpp);
xwrites('Copy to Folder: ');
xreadlnse(folder,max(cols-20,70),yespreserve,endkeyswithspace);
xclreolxy(1,lpp);
if folder<>'' then
if (numoccur('\',unslash(folder))<>0) or
(numoccur(':',folder)<>0) or (pos('..',folder)<>0) then
warn('illegal folder name: '+folder)
else
begin
if folder[1]<>'=' then
folder := '='+folder;
lastfolder := folder;
xwritesss('Copying to ',folder,'...');
unfoldergroup(folder);
if not joinedtoexactgroup(folder) then
begin
xclreolxy(1,lpp-1);
xclreolxy(1,lpp);
xwritesss('Not joined to ',folder,', doing so now...');
addnewmailgroup(folder);
end;
folderdir := getgroupdir(folder);
mkhier(folderdir);
for currart := lowart to highart do
if selected[currart] then
begin
xclreolxy(1,lpp);
xwritesss('Working on ',articles[currart]^.filename,'...');
infn := withbackslash(currdir)+articles[currart]^.filename;
copyfile(infn,getuniqfile(folderdir));
end;
end; {legal folder}
end; {thisallforgetit}
selrefresh;
end;
procedure movehighlightedarts;
var
folder: string;
folderdir: string;
thisallforgetit: char;
lowart, highart: integer;
anyselected: boolean;
currart: integer;
infn: string;
begin
thisallforgetit := 'a';
if not ismailgroup(currsource) then
begin
warn('not a mail group -- using Copy instead');
copyhighlightedarts;
thisallforgetit := 'f';
end
else
begin
{don't ask unless there's more than one page}
if (topline<>1) or (botline<>numarts) then
thisallforgetit := onekeydef(
'Move: {t}his page, {a}ll pages, {f}orget it','taf','f');
if thisallforgetit='t' then
begin
lowart := topline;
highart := botline;
end
else
begin
lowart := 1;
highart := numarts;
end;
end;
anyselected := false;
for currart := lowart to highart do
if selected[currart] then
anyselected := true;
if not anyselected and (thisallforgetit<>'f') then
begin
warn('none selected');
thisallforgetit := 'f';
end;
if thisallforgetit<>'f' then
begin
if not quiet then
begin
xclreolxy(1,lpp-3);
xclreolxy(1,lpp-2);
xwritelns('Enter a folder (e.g., `=misc'') as a destination for');
xclreolxy(1,lpp-1);
xwritelns('these articles, or leave blank to abort');
end;
folder := lastfolder;
xclreolxy(1,lpp);
xwrites('Move to Folder: ');
xreadlnse(folder,max(cols-20,70),yespreserve,endkeyswithspace);
xclreolxy(1,lpp);
if folder<>'' then
if (numoccur('\',unslash(folder))<>0) or
(numoccur(':',folder)<>0) or (pos('..',folder)<>0) then
warn('illegal folder name: '+folder)
else
begin
if folder[1]<>'=' then
folder := '='+folder;
lastfolder := folder;
xwritesss('Moving to ',folder,'...');
unfoldergroup(folder);
if not joinedtoexactgroup(folder) then
addnewmailgroup(folder);
folderdir := getgroupdir(folder);
mkhier(folderdir);
for currart := lowart to highart do
if selected[currart] then
begin
xclreolxy(1,lpp);
xwritesss('Working on ',articles[currart]^.filename,'...');
infn := withbackslash(currdir)+articles[currart]^.filename;
copyfilethenempty(infn,getuniqfile(folderdir));
end;
end; {legal folder}
end; {thisallforgetit}
selrefresh;
end;
procedure selnextnoupdate;
begin
donegroupsel := true;
highestread := 0;
end;
procedure selquitnoupdate;
var
doit: boolean;
whichart: integer;
begin
doit := true;
if confirmquit then
doit := (onekey('are you SURE you want to quit? {y}/{n}','yn')='y');
if not doit then
selrefresh
else
begin
needtofindnextgroup := false;
currsource := '';
selclearall;
selnextnoupdate;
end;
end;
procedure unsubscribe;
var
doit: boolean;
nextgroup: string;
begin
doit :=
(onekey('are you SURE you want to unsubscribe? {y}/{n}','yn')='y');
if not doit then
selrefresh
else
begin
nextgroup := getnextgroup; {empty string is ok, too}
xclreolxy(1,lpp);
updatejoinunsubscribe;
selclearall;
currsource := nextgroup;
needtofindnextgroup := false;
selnextnoupdate;
end;
end;
procedure gotonewsource;
var
trysource: string;
trysourcekind: sourcetype;
begin
trysource := '';
pickasource(trysource,trysourcekind);
xclreolxy(1,lpp);
if trysource='' then
begin
selrefresh;
end
else
begin
selclearall;
currsource := trysource;
currsourcekind := trysourcekind;
needtofindnextgroup := false;
selnextnoupdate;
end;
end;
procedure showgrouplist;
var
done: boolean;
quitout: boolean;
whichgroupi: integer;
ypos: integer;
maxypos: integer;
toplineused: integer;
bottomlineused: integer;
agroup: string;
unreadcount: articlefilenametype;
unreadstring: string;
tempstr: string;
wastec: char;
inkey: char;
groupwidth: integer;
unreadwidth: integer;
descwidth: integer;
{ 36 is max 26 letters+max 10 digits }
showngroupindices: array[1..36] of integer;
didgoto: boolean;
procedure showgroupnewscreen;
var
tempint: integer;
begin {showgroupnewscreen}
xclrscr;
xgotoxy(1,1);
{ gets overwritten _immediately_, before disk i/o }
{
xwrites('Reading...');
}
ypos := 0;
toplineused := ypos+2; {clearly too large}
bottomlineused := ypos;
for tempint := 1 to 36 do
showngroupindices[tempint] := -1;
end; {showgroupnewscreen}
begin
maxypos := min(lpp-3,36);
didgoto := false;
groupwidth := max(cols div 2-10,10);
unreadwidth := 4;
{
cols-1 to prevent screen overflow
2 for selection letter/digit and space
groupwidth+1 for group name and space
unreadwidth+1 for unread count and space
}
descwidth := cols-1 - 2 - (groupwidth+1) - (unreadwidth+1);
whichgroupi := 0;
showgroupnewscreen;
quitout := false;
done := false;
if descwidth<10 then
begin
xwrites('screen too small, sorry');
done := true;
end;
while not done and not quitout do
begin
inc(whichgroupi);
done := whichgroupi>numjoined;
if not done then
begin
inc(ypos);
showngroupindices[ypos] := whichgroupi;
xclreolxy(1,ypos);
xwritess(whichselchar(ypos),' ');
toplineused := min(toplineused,ypos);
bottomlineused := max(bottomlineused,ypos);
agroup := joinedgroups[showngroupindices[ypos]];
tempstr := leftjustify(right(agroup,groupwidth),groupwidth,' ');
xwritess(tempstr,' '); {clearer than leftjustify with width +1}
xwrites('...');
unreadcount := unreadarticlesin(agroup,sourcegroup);
{ backspace over 3 dots earlier }
xwrites(^H^H^H);
tempstr := ltoa(unreadcount);
if length(tempstr)>unreadwidth then
tempstr := '!';
tempstr := rightjustify(tempstr,unreadwidth,' ');
xwritess(tempstr,' ');
xwrites(copy(sourcedesc(agroup,sourcegroup),1,descwidth));
end;
if xkeypressed or (ypos>=maxypos) or done then
begin
if xkeypressed then
wastec := xreadkey;
xclreolxy(1,lpp);
if done then
xwritehighlights(
'select, or any other key to quit ')
else
xwritehighlights(
'select, or {space} to continue, any other key to quit ');
{
inkey := xreadkey;
}
inkey := xreadkeyextended(0,0,toplineused,bottomlineused);
xclreolxy(1,lpp);
if islower(inkey) or isdigit(inkey) then
if showngroupindices[selcharnum(inkey)]>0 then
begin
currsource :=
joinedgroups[showngroupindices[selcharnum(inkey)]];
currsourcekind := sourcegroup;
needtofindnextgroup := false;
selnextnoupdate;
selclearall;
didgoto := true;
quitout := true; {redundant, but clear}
end;
if inkey<>' ' then
quitout := true;
if ypos>=maxypos then
if not quitout then
if not done then
showgroupnewscreen;
end;
end;
if not didgoto then
selrefresh;
end;
procedure selprevgroup;
var
prevgroup: string;
foundgroup: string;
begin
selclearall;
prevgroup := '..invalid..';
foundgroup := prevgroup;
reset(joinf);
repeat
prevgroup := foundgroup;
readln(joinf,foundgroup);
foundgroup := getfirstw(foundgroup);
until foundgroup=currsource;
{}{should check eof - I guess}
if prevgroup<>'..invalid..' then
begin
currsource := prevgroup;
donegroupsel := true;
needtofindnextgroup := false;
end;
{}{need more error checking here...}
{}{also, it just goes back 1 group - not to the one with something to read!}
end;
procedure selsearch;
var
searchstring: string;
upselsearchstring: string;
whichart: integer;
begin
xclreolxy(1,lpp);
xwrites('=');
searchstring := selsearchstring;
xreadlns(searchstring,max(cols-4,76),yespreserve);
if searchstring<>'' then
begin
selsearchstring := searchstring;
upselsearchstring := upper(searchstring);
for whichart := 1 to numarts do
if textintext(upselsearchstring,upper(articles[whichart]^.from)) then
setselected(whichart,true)
else if textintext(upselsearchstring,
upper(articles[whichart]^.basesubject)) then
setselected(whichart,true);
end;
selrefresh;
end;
procedure selnextlayout;
begin
layout := succ(layout);
if layout=layoutlast then
layout := succ(layoutfirst);
selrefresh;
end;
procedure selhelppage;
var
wastec: char;
begin
xclrscr;
hwritexy(1,1,
newsreadername+' '+newsreaderversion+' - newsreader-under-development');
hwritexy(1,2,
'Russell_Schulz@locutus.ofB.ORG ('+releasedate+')');
hwritexy(1,4,
'{letter},{digit} - toggle whether or not to read that article');
hwritexy(1,5,
'{c-f} - toggle c through and including f');
hwritexy(1,6,
'{g*} - toggle g and all with same subject');
hwritexy(1,7,
'{space},{enter} - go to next screen (or start browsing if at end)');
hwritexy(1,8,
'{N} - go to next group (but browse selected articles first)');
hwritexy(1,9,
'{X} - like {N}, but mark {all} articles as read after');
hwritexy(1,10,
'{P} - go to previous group {+} select antikilled articles');
hwritexy(1,11,
'{@} - toggle all on this page {=} select ones that match some word');
hwritexy(1,12,
'{%},{~} - select, unselect all articles (all pages)');
hwritexy(1,13,
'{^L} - refresh screen {^R} - reread kill and antikill files');
hwritexy(1,14,
'{<},{>} - go back, forward a page (wraps around if you go too far)');
hwritexy(1,15,
'{^},{$} - first, last page {!} shell escape {"} change layout');
hwritexy(1,16,
'{Z} - browse articles on this page (but do {not} mark as read)');
hwritexy(1,17,
'{W} {S} - write/save selected articles (this or all pages)');
hwritexy(1,18,
'{C} {M} - copy/move selected articles to folder (this or all pages)');
hwritexy(1,19,
'{G} - goto group; can shorten each word (eg. c.o.m.ma)');
hwritexy(1,20,
'{U} - unsubscribe from this group {Y} - show group list');
hwritexy(1,21,
'{?} - help {:} command mode {Q} - quit');
hwritexy(1,23,
'press any key to return ');
wastec := xreadkey;
selrefresh;
end;
procedure selcommand;
var
commandline: string;
commandverb: string;
begin
xclreolxy(1,lpp);
xwrites(':');
xreadlns(commandline,max(cols-4,76),nopreserve);
internalcmdlineparams := commandline;
commandverb := lower(chopfirstw(internalcmdlineparams));
if commandline='' then
selrefresh
else
begin
if partialmatch(commandverb,'help','h') then
selhelppage
else if partialmatch(commandverb,'?','?') then
selhelppage
else if partialmatch(commandverb,'next','n') then
begin xwriteln; selnextnoupdate; end
else if partialmatch(commandverb,'postfile','postf') then
begin postfile; selrefresh; end
else if partialmatch(commandverb,'post','p') then
begin post; selrefresh; end
else if partialmatch(commandverb,'mailfile','mailf') then
begin mailfile; selrefresh; end
else if partialmatch(commandverb,'mail','m') then
begin mail; selrefresh; end
else if partialmatch(commandverb,'set','set') then
begin
justhandleset(internalcmdlineparams,issuspicious);
selrefresh;
end
else if partialmatch(commandverb,'unset','unset') then
begin
justhandleunset(internalcmdlineparams,issuspicious);
selrefresh;
end
else if partialmatch(commandverb,'show','sho') then
begin
usershow(internalcmdlineparams);
selrefresh;
end
else if partialmatch(commandverb,'version','v') then
begin
showversion;
selrefresh;
end
else if partialmatch(commandverb,'quit','q') then
begin xwriteln; selquitnoupdate; end
else
begin
warn('unrecognized command');
selrefresh;
end;
end;
end;
procedure selcatch;
begin
donegroupsel := true;
highestread := highestart;
end;
procedure selspace;
var
artnum: integer;
anyselected: boolean;
begin
if makespacelikex and (botline=numarts) then
begin
anyselected := false;
for artnum := 1 to numarts do
if selected[artnum] then
anyselected := true;
if anyselected then
selcatch
else
donepagesel := true;
end
else
donepagesel := true;
end;
procedure selantikill(firstantikill: boolean);
var
whichart: integer;
firstnew: integer; {firstnew=maxint <=> no articles antikilled}
begin
firstnew := maxint;
for whichart := 1 to numarts do
if ((articles[whichart]^.indents and 128)<>0)
and
not selected[whichart] then
begin
firstnew := min(firstnew,whichart);
setselected(whichart,true);
end;
if firstnew<=numarts then
begin
if (firstnew>sellpp) and warnautoantikill then
begin
if firstantikill then
selrefresh;
warn('at least one article antikilled');
end;
{do we need this anymore with the selrefreshbotline?}
if not firstantikill then
selrefresh;
end;
selrefreshbotline;
end;
procedure rereadkillfiles;
begin
readinkill(nobackupkill);
readinantikill(nobackupkill);
if autoantikill then
selantikill(nofirstantikill);
selrefresh;
end;
begin {selectandbrowse}
if ismailgroup(currsource) then
dateformat := maildateformat
else
dateformat := newsdateformat;
for whichart := 1 to numarts do
selected[whichart] := false;
numselected := 0;
donegroupsel := (numarts=0);
lastinkey := ' ';
lastselected := false;
topline := 1;
selsearchstring := '';
currsourcedesc := sourcedesc(currsource,currsourcekind);
setupselheaderline;
if not donegroupsel and autoantikill then
selantikill(yesfirstantikill);
moreselecting := false;
skipsection := false;
starbeside := 0;
while not moreselecting and not donegroupsel and (currsource<>'') do
begin
donepagesel := false;
selrefresh;
while not donegroupsel and not donepagesel and (currsource<>'') do
begin
inkey := xreadkeyextended(0,0,
2+selheaderlines,(botline-topline)+2+selheaderlines);
inkey := selmap[inkey];
if isselchar(inkey) then
togglekey(inkey)
else if (inkey='*') and isselchar(lastinkey) then
dostar(lastinkey)
else if (inkey='-') and isselchar(lastinkey) then
dodash(lastinkey)
else
case inkey of
'?': selhelppage;
'<': backpage;
^B : backpage;
'>': forwardpage;
^F : forwardpage;
'^': firstpage;
^A : firstpage;
'$': lastpage;
^E : lastpage;
' ': selspace;
cr: selspace;
'Z': browseandreturn;
'W': writehighlightedarts;
'S': savehighlightedarts;
'C': copyhighlightedarts;
'M': movehighlightedarts;
'U': unsubscribe;
'G': gotonewsource;
'Y': showgrouplist;
'N': selnextnoupdate;
'@': selreversepage;
'%': begin selselectall; selrefresh; end;
'~': begin selclearall; selrefresh; end;
'X': selcatch;
'P': selprevgroup;
^L : selrefresh;
^R : rereadkillfiles;
'!': begin shellout; selrefresh; end;
'+': selantikill(nofirstantikill);
'=': selsearch;
':': selcommand;
'"': selnextlayout;
'Q': selquitnoupdate;
end; {case}
lastinkey := inkey;
end;
if botline<numarts then
inc(topline,sellpp)
else
donegroupsel := true;
{moreselecting is always false here}
if donegroupsel then
viewarts(1,numarts,true);
if moreselecting then
donegroupsel := false;
moreselecting := false;
end;
end;
end.